home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / modes / c-comment.el.z / c-comment.el
Encoding:
Text File  |  1998-05-21  |  11.7 KB  |  333 lines
  1. ;;; c-comment.el --- edit C comments
  2.  
  3. ;; Copyright (C) 1987, 1988, 1989 Kyle E. Jones
  4. ;; Copyright (C) 1997 Free Software Foundation, Inc.
  5.  
  6. ;; Author: Kyle Jones <kyle_jones@wonderworks.com>
  7. ;; Maintainer: XEmacs Development Team
  8. ;; Keywords: languages
  9.  
  10. ;; This file is part of XEmacs.
  11.  
  12. ;; XEmacs is free software; you can redistribute it and/or modify it
  13. ;; under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; XEmacs is distributed in the hope that it will be useful, but
  18. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20. ;; General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with XEmacs; see the file COPYING.  If not, write to
  24. ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25. ;; Boston, MA 02111-1307, USA.
  26.  
  27. ;;; Synched up with: Not in FSF.
  28.  
  29. ;;; Commentary:
  30.  
  31. ;;
  32. ;; Verbatim copies of this file may be freely redistributed.
  33. ;;
  34. ;; Modified versions of this file may be redistributed provided that this
  35. ;; notice remains unchanged, the file contains prominent notice of
  36. ;; author and time of modifications, and redistribution of the file
  37. ;; is not further restricted in any way.
  38. ;;
  39. ;; This file is distributed `as is', without warranties of any kind.
  40.  
  41. ;; sb [23-Oct-1997] Put into standard format, fixed an autoload cookie.
  42.  
  43. ;;; Code:
  44.  
  45. (provide 'c-comment-edit)
  46.  
  47. (defvar c-comment-leader " *"
  48.   "*Leader used when rebuilding edited C comments.  The value of this variable
  49. should be a two-character string.  Values of \"  \", \" *\" and \"**\" produce the
  50. comment styles:
  51.     /*    /*    /*
  52.       ...     * ...    ** ...
  53.       ...     * ...    ** ...
  54.     */     */    */
  55. respectively.")
  56.  
  57. (defconst c-comment-leader-regexp "^[     ]*\\(\\*\\*\\|\\*\\)?[ ]?"
  58.   "Regexp used to match C comment leaders.")
  59.  
  60. (defvar c-comment-edit-mode 'text-mode
  61.   "*Major mode used by `c-comment-edit' when editing C comments.")
  62.  
  63. (defvar c-comment-edit-hook nil
  64.   "*Function to call whenever `c-comment-edit' is used.
  65. The function is called just before the `c-comment-edit' function allows you to
  66. begin editing the comment.")
  67.  
  68. (defvar c-comment-edit-buffer-alist nil
  69.   "Assoc list of C buffers and their associated comment buffers.
  70. Elements are of the form (C-BUFFER COMMENT-BUFFER COMMENT-START COMMENT-END)
  71. COMMENT-START and COMMENT-END are markers in the C-BUFFER.")
  72.  
  73. (defmacro save-point (&rest body)
  74.   "Save value of point, evalutes FORMS and restore value of point.
  75. If the saved value of point is no longer valid go to (point-max).
  76. The variable `save-point' is lambda-bound to the value of point for
  77. the duration of this call."
  78.   (list 'let '((save-point (point)))
  79.     (list 'unwind-protect
  80.           (cons 'progn body)
  81.           '(goto-char (min (point-max) save-point)))))
  82.  
  83. (defmacro marker (pos &optional buffer)
  84.   (list 'set-marker '(make-marker) pos buffer))
  85.  
  86. (defvar c-comment-edit-map nil "Key map for c-comment-edit buffers")
  87. (if c-comment-edit-map
  88.     nil
  89.   (setq c-comment-edit-map (make-sparse-keymap))
  90.   (define-key c-comment-edit-map [(meta control c)] 'c-comment-edit-end)
  91.   (define-key c-comment-edit-map [(control c) (control c)] 'c-comment-edit-end)
  92.   (define-key c-comment-edit-map [(control c) (control ?\])] 'c-comment-edit-abort))
  93.  
  94. ;;;###autoload
  95. (defun c-comment-edit (search-prefix)
  96.   "Edit multi-line C comments.
  97. This command allows the easy editing of a multi-line C comment like this:
  98.    /*
  99.     * ...
  100.     * ...
  101.     */
  102. The comment may be indented or flush with the left margin.
  103.  
  104. If point is within a comment, that comment is used.  Otherwise the
  105. comment to be edited is found by searching forward from point.
  106.  
  107. With one \\[universal-argument] searching starts after moving back one
  108.   paragraph.
  109. With two \\[universal-argument]'s searching starts at the beginning of the
  110.   current or proceeding C function.
  111. With three \\[universal-argument]'s searching starts at the beginning of the
  112.   current page.
  113. With four \\[universal-argument]'s searching starts at the beginning of the
  114.   current buffer (clipping restrictions apply).
  115.  
  116. Once located, the comment is copied into a temporary buffer, the comment
  117. leaders and delimiters are stripped away and the resulting buffer is
  118. selected for editing.  The major mode of this buffer is controlled by
  119. the variable `c-comment-edit-mode'.\\<c-comment-edit-map>
  120.  
  121. Use \\[c-comment-edit-end] when you have finished editing the comment.  The
  122. comment will be inserted into the original buffer with the appropriate
  123. delimiters and indention, replacing the old version of the comment.  If
  124. you don't want your edited version of the comment to replace the
  125. original, use \\[c-comment-edit-abort]." 
  126.   (interactive "*P")
  127.   (let ((c-buffer (current-buffer))
  128.     marker tem c-comment-fill-column c-comment-buffer
  129.     c-comment-start c-comment-end
  130.     (inhibit-quit t))
  131.     ;; honor search-prefix
  132.     (cond ((equal search-prefix '(4))
  133.        (backward-paragraph))
  134.       ((equal search-prefix '(16))
  135.        (end-of-defun)
  136.        (beginning-of-defun)
  137.        (backward-paragraph))
  138.       ((equal search-prefix '(64))
  139.        (backward-page))
  140.       ((equal search-prefix '(256))
  141.        (goto-char (point-min))))
  142.     (if (and (null search-prefix) (setq tem (within-c-comment-p)))
  143.     (setq c-comment-start (marker (car tem))
  144.           c-comment-end (marker (cdr tem)))
  145.       (let (start end)
  146.     (condition-case error-data
  147.         (save-point
  148.           (search-forward "/*")
  149.           (setq start (- (point) 2))
  150.           (search-forward "*/")
  151.           (setq end (point)))
  152.       (search-failed (error "No C comment found.")))
  153.     (setq c-comment-start (marker start))
  154.     (setq c-comment-end (marker end))))
  155.     ;; calculate the correct fill-column for the comment
  156.     (setq c-comment-fill-column (- fill-column
  157.                    (save-excursion
  158.                      (goto-char c-comment-start)
  159.                      (current-column))))
  160.     ;; create the comment buffer
  161.     (setq c-comment-buffer
  162.       (generate-new-buffer (concat (buffer-name) " *C Comment Edit*")))
  163.     ;; link into the c-comment-edit-buffer-alist
  164.     (setq c-comment-edit-buffer-alist
  165.       (cons (list (current-buffer) c-comment-buffer
  166.               c-comment-start c-comment-end)
  167.         c-comment-edit-buffer-alist))
  168.     ;; copy to the comment to the comment-edit buffer
  169.     (copy-to-buffer c-comment-buffer (+ c-comment-start 2) (- c-comment-end 2))
  170.     ;; mark the position of point, relative to the beginning of the
  171.     ;; comment, in the comment buffer.  (iff point is within a comment.)
  172.     (or search-prefix (< (point) c-comment-start)
  173.     (setq marker (marker (+ (- (point) c-comment-start 2) 1)
  174.                  c-comment-buffer)))
  175.     ;; select the comment buffer for editing
  176.     (switch-to-buffer c-comment-buffer)
  177.     ;; remove the comment leaders and delimiters
  178.     (goto-char (point-min))
  179.     (while (not (eobp))
  180.       (and (re-search-forward c-comment-leader-regexp nil t)
  181.        (replace-match "" nil t))
  182.       (forward-line))
  183.     ;; run appropriate major mode
  184.     (funcall (or c-comment-edit-mode 'fundamental-mode))
  185.     ;; override user's default fill-column here since it will lose if
  186.     ;; the comment is indented in the C buffer.
  187.     (setq fill-column c-comment-fill-column)
  188.     ;; delete one leading whitespace char
  189.     (goto-char (point-min))
  190.     (if (looking-at "[ \n\t]")
  191.     (delete-char 1))
  192.     ;; restore cursor if possible
  193.     (goto-char (or marker (point-min)))
  194.     (set-buffer-modified-p nil)
  195.     (use-local-map c-comment-edit-map c-comment-buffer))
  196.   ;; run user hook, if present.
  197.   (if c-comment-edit-hook
  198.       (funcall c-comment-edit-hook))
  199.   ;; final admonition
  200.   (message
  201.    (substitute-command-keys
  202.     "Type \\[c-comment-edit-end] to end edit, \\[c-comment-edit-abort] to abort with no change.")))
  203.  
  204. (defun c-comment-edit-end ()
  205.   "End c-comment-edit.
  206. C comment is replaced by its edited counterpart in the appropriate C buffer.
  207. Indentation will be the same as the original."
  208.   (interactive)
  209.   (let ((tuple (find-c-comment-buffer)))
  210.     (if (null tuple)
  211.     (error "Not a c-comment-edit buffer."))
  212.     (let ((inhibit-quit t)
  213.       (c-comment-c-buffer (car tuple))
  214.       (c-comment-buffer (nth 1 tuple))
  215.       (c-comment-start (nth 2 tuple))
  216.       (c-comment-end (nth 3 tuple)))
  217.       (cond
  218.        ((buffer-modified-p)
  219.     ;; rebuild the comment
  220.     (goto-char (point-min))
  221.     (insert "/*\n")
  222.     (if (string= c-comment-leader "  ")
  223.         (while (not (eobp))
  224.           (if (not (eolp))
  225.           (insert c-comment-leader " "))
  226.           (forward-line))
  227.       (while (not (eobp))
  228.         (insert c-comment-leader (if (eolp) "" " "))
  229.         (forward-line)))
  230.     (if (not (char-equal (preceding-char) ?\n))
  231.         (insert "\n"))
  232.     (insert (if (string= c-comment-leader " *") " */" "*/"))
  233.     ;; indent if necessary
  234.     (let ((indention
  235.            (save-excursion
  236.          (set-buffer c-comment-c-buffer)
  237.          (goto-char c-comment-start)
  238.          (current-column))))
  239.       (goto-char (point-min))
  240.       (cond ((not (zerop indention))
  241.          ;; first line is already indented
  242.          ;; in the C buffer
  243.          (forward-line)
  244.          (while (not (eobp))
  245.            (indent-to indention)
  246.            (forward-line)))))
  247.     ;; replace the old comment with the new
  248.     (save-excursion
  249.       (set-buffer c-comment-c-buffer)
  250.       (save-point
  251.         (save-excursion
  252.           (delete-region c-comment-start c-comment-end)
  253.           (goto-char c-comment-start)
  254.           (set-buffer c-comment-buffer)
  255.           (append-to-buffer c-comment-c-buffer
  256.                 (point-min) (point-max))))))
  257.        (t (message "No change.")))
  258.       ;; switch to the C buffer
  259.       (if (get-buffer-window c-comment-c-buffer)
  260.       (select-window (get-buffer-window c-comment-c-buffer))
  261.     (switch-to-buffer c-comment-c-buffer))
  262.       ;; delete the window viewing the comment buffer
  263.       (and (get-buffer-window c-comment-buffer)
  264.        (delete-window (get-buffer-window c-comment-buffer)))
  265.       ;; unlink the tuple from c-comment-edit-buffer-alist
  266.       (setq c-comment-edit-buffer-alist
  267.         (delq tuple c-comment-edit-buffer-alist))
  268.       ;; let Emacs reclaim various resources
  269.       (save-excursion
  270.     (set-buffer c-comment-buffer)
  271.     (set-buffer-modified-p nil)
  272.     (kill-buffer c-comment-buffer))
  273.       (set-marker c-comment-start nil)
  274.       (set-marker c-comment-end nil))))
  275.  
  276. (defun c-comment-edit-abort ()
  277.   "Abort a c-comment-edit with no change."
  278.   (interactive)
  279.   (let* ((tuple (find-c-comment-buffer))
  280.      (c-comment-c-buffer (car tuple))
  281.      (c-comment-buffer (nth 1 tuple))
  282.      (c-comment-start (nth 2 tuple))
  283.      (c-comment-end (nth 3 tuple)))
  284.     (if (null tuple)
  285.     (error "Not a c-comment-edit buffer."))
  286.     ;; switch to the C buffer
  287.     (if (get-buffer-window c-comment-c-buffer)
  288.     (select-window (get-buffer-window c-comment-c-buffer))
  289.       (switch-to-buffer c-comment-c-buffer))
  290.     (let ((inhibit-quit t))
  291.       (save-excursion
  292.     (set-buffer c-comment-buffer)
  293.     (set-buffer-modified-p nil)
  294.     (kill-buffer c-comment-buffer))
  295.       ;; unlink the tuple from c-comment-edit-buffer-alist
  296.       (setq c-comment-edit-buffer-alist
  297.         (delq tuple c-comment-edit-buffer-alist))
  298.       (set-marker c-comment-start nil)
  299.       (set-marker c-comment-end nil)
  300.       (message "Aborted with no change."))))
  301.  
  302. ;; this loses on /* /* */ but doing it right would be grim.
  303. (defun within-c-comment-p ()
  304.   (condition-case error-data
  305.       (let (start end)
  306.     (save-point
  307.       (search-backward "/*")
  308.       (setq start (point))
  309.       (search-forward "*/")
  310.       (setq end (point)))
  311.     (if (< (point) end) (cons start end) nil))
  312.     (search-failed nil)))
  313.  
  314. (defun find-c-comment-buffer (&optional buffer)
  315.   (or buffer (setq buffer (current-buffer)))
  316.   (let ((list c-comment-edit-buffer-alist))
  317.     (catch 'return-value
  318.       (while list
  319.     (if (eq (nth 1 (car list)) buffer)
  320.         (throw 'return-value (car list))
  321.       (setq list (cdr list)))))))
  322.         
  323. (defun find-c-comment-c-buffer (&optional buffer)
  324.   (or buffer (setq buffer (current-buffer)))
  325.   (let ((list c-comment-edit-buffer-alist))
  326.     (catch 'return-value
  327.       (while list
  328.     (if (eq (car (car list)) buffer)
  329.         (throw 'return-value (car list))
  330.       (setq list (cdr list)))))))
  331.  
  332. ;;; c-comment.el ends here
  333.